home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / EVENT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-25  |  17KB  |  499 lines
  1. UNIT Event;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Event handler & supporting routines           Last changed: 25.06.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32;
  16.  
  17. FUNCTION  CalculateNextTime: LongInt;
  18. PROCEDURE ChangeEvent(TestChange: Boolean);
  19. PROCEDURE CalculateEventTimes(JustTest: Boolean);
  20.  
  21. CONST
  22.   TimeToNextEvent       : LongInt = 0;
  23.   TimeToNextForcedEvent : LongInt = 0;
  24.   TimeToNoMoreRequest   : LongInt = 0;
  25. { NextEventNumber       : LongInt = 0;}
  26.  
  27. IMPLEMENTATION
  28.  
  29. USES Dos, OpDate, OpString, OpRoot, ApTimer,
  30.      Com, StrUtil, Util, Globals, Display, FileUtil, LogFile, NetFile,
  31.      List, PoPTypes, Send2Utl, OutUtil, OutInfo, MailUtil, Modem,
  32.      MailScan, OproUtil;
  33.  
  34. CONST
  35.   NextEventTimer : EventTimer = (StartTics: 0; ExpireTics: 0);
  36.  
  37.   FUNCTION CalculateNextTime: LongInt;
  38.   VAR
  39.     Tmp      : POutList;
  40.     NumNodes : Word;
  41.     CalcTime : LongInt;
  42.   BEGIN
  43.     WITH CurrentEvent DO
  44.       IF (Data.Event>0) AND (CallTime<>0) THEN
  45.         CalcTime:=CallTime+Random(callwidth)
  46.       ELSE
  47.         CalcTime:=Cfg.CallTime+Random(cfg.callwidth);
  48.     NumNodes:=0;
  49.     Tmp:=POutList(OutList^.Head);
  50.     WHILE Tmp<>NIL DO
  51.     BEGIN
  52.       IF Tmp^.Known AND SendableData(Tmp) THEN Inc(NumNodes);
  53.       Tmp:=POutList(OutList^.Next(Tmp));
  54.     END;
  55.     IF NumNodes=0 THEN NumNodes:=1;
  56.     CalculateNextTime:=CalcTime DIV NumNodes;
  57.   END;
  58.  
  59.   FUNCTION GetDayMask(CONST Day: Byte) : Byte;
  60.   BEGIN
  61.     CASE Day OF
  62.       0 : getdaymask:=128+64;
  63.       1 : getdaymask:=128+1;
  64.       2 : getdaymask:=128+2;
  65.       3 : getdaymask:=128+4;
  66.       4 : getdaymask:=128+8;
  67.       5 : getdaymask:=128+16;
  68.       6 : getdaymask:=128+32;
  69.     END;
  70.   END;
  71.  
  72.   FUNCTION DaysTillRun(CONST Event: TEvent): LongInt;
  73.   VAR
  74.     Flag:BOOLEAN;
  75.     DatoAar, DatoMaaned, DatoDag, DatoDofW,
  76.     Nd,DDay,DMonth,DYear,SDay,SMonth,SYear,EDay:Word;
  77.     d : LongInt;
  78.   BEGIN
  79.     GetDate(DatoAar,DatoMaaned,DatoDag,DatoDofW);
  80.     WITH Event DO
  81.     BEGIN
  82.      IF Event.Active>128 THEN
  83.      BEGIN
  84.       d:=0;
  85.       IF NOT ((GetDayMask(DatoDofW) AND Event.Active>128) AND
  86.          ((Event.Start+1>Data.LastEventStart) OR (Data.LastEventDate<>Today)) AND
  87.          ((Day=0) OR (Day=DatoDag)) AND
  88.          ((Month=0) OR (Month=DatoMaaned))) THEN
  89.       BEGIN
  90.         EDay:=DatoDofw;
  91.         DDay:=DatoDag; DMonth:=DatoMaaned; DYear:=DatoAar;
  92.         SDay:=DatoDag; SMonth:=DatoMaaned; SYear:=DatoAar;
  93.         Nd:=DaysInMonth(DMonth,DYear);
  94.         REPEAT
  95.           INC(DDay);
  96.           IF DDay>Nd THEN
  97.           BEGIN
  98.             DDay:=1;
  99.             INC(DMonth);
  100.             IF DMonth>12 THEN
  101.             BEGIN
  102.               DMonth:=1;
  103.               INC(DYear);
  104.             END;
  105.             Nd:=DaysInMonth(DMonth,DYear);
  106.           END;
  107.           INC(EDay);
  108.           IF EDay>6 THEN EDay:=0;
  109.           INC(d);
  110.           IF ((Day=0) OR (DDay=Day)) THEN Flag:=TRUE ELSE Flag:=False;
  111.           IF Flag AND (Month<>0) AND (DMonth<>Month) THEN Flag:=False;
  112.           IF Flag AND (Active AND GetDayMask(EDay)<=128) THEN Flag:=False;
  113.         UNTIL Flag;
  114.       END;
  115.      END ELSE
  116.        d:=7*366;
  117.     END;
  118.     DaysTillRun:=d;
  119.   END;
  120.  
  121.   PROCEDURE CalculateEventTimes(JustTest: Boolean);
  122.   VAR
  123.     x         : LongInt;
  124.     EventFile : TNetFile;
  125.     TmpEvent  : TEvent;
  126.   BEGIN
  127.     TimeToNoMoreRequest:=366*SecondsInDay;
  128.     TimeToNextForcedEvent:=366*SecondsInDay;
  129.     TimeToNextEvent:=SecondsInDay;
  130.     IF EventFile.Open(StartPath+PoPEventFileName, SizeOf(TEvent),False)THEN
  131.     BEGIN
  132.       WHILE NOT EventFile.EOF DO
  133.       BEGIN
  134.         EventFile.Read(TmpEvent,NoKeep,Wait);
  135.         IF (TmpEvent.TaskNumber=0) OR (TmpEvent.TaskNumber=Cfg.TaskNumber) THEN
  136.         BEGIN
  137.           x:=(DaysTillRun(TmpEvent)*SecondsInDay)+TmpEvent.Start-CurrentTime;
  138.           IF x>=0 THEN
  139.           BEGIN
  140.             IF x<TimeToNextEvent THEN TimeToNextEvent:=x;
  141.             IF (TmpEvent.Typ AND etForced<>0) AND
  142.                (x<TimeToNextForcedEvent) THEN TimeToNextForcedEvent:=x;
  143.             IF (((TmpEvent.Typ AND etForced)<>0) OR
  144.                 ((TmpEvent.Typ AND etRequests)=0)) AND
  145.                (x<TimeToNoMoreRequest) THEN TimeToNoMoreRequest:=x;
  146.           END;
  147.         END;
  148.       END;
  149.       EventFile.Close;
  150.     END;
  151. { Debug info, do *NOT* remove
  152.     FastWrite('NE='+TimeToTimeString('hh:mm',TimeToNextEvent)+
  153.               ' NR='+TimeToTimeString('hh:mm',TimeToNoMoreRequest)+
  154.               ' NF='+TimeToTimeString('hh:mm',TimeToNextForcedEvent),1,1,7);
  155. }
  156.     IF NOT JustTest THEN NewTimerSecs(NextEventTimer, TimeToNextEvent);
  157.   END;
  158.  
  159.   PROCEDURE ChangeEvent(TestChange: Boolean);
  160.   VAR
  161.     TmpEvent  : TEvent;
  162.     newevent  : Byte;
  163.     n, n2     : Time;
  164.     x         : LongInt;
  165.     EventFile : TNetFile;
  166.     CorrectEvent, DatoAar, DatoMaaned, DatoDag, DatoDofW: Word;
  167.  
  168.     PROCEDURE CheckSchedules;
  169.     VAR
  170.       f : TNetFile;
  171.       Tab:SendToTabType;
  172.       Num:Byte;
  173.       Schedule : TSchedule;
  174.  
  175.       PROCEDURE ScheduledPoll;
  176.       VAR
  177.         i:Byte;
  178.         ch : Char;
  179.       BEGIN
  180.         FOR i:=1 TO Num DO
  181.           WITH Tab[i] DO
  182.             IF NoAll(Tab[i]) THEN
  183.             BEGIN
  184.               IF Schedule.stat='N' THEN ch:='F' ELSE ch:=Schedule.Stat;
  185.               MakeAPoll(Tab[i],ch);
  186.               AddLog('!','Creating poll for '+Address2Str(Tab[i]));
  187.             END;
  188.       END;
  189.  
  190.       PROCEDURE ScheduledChange;
  191.       VAR
  192.         ch,ch2:Char;
  193.         b, i : Byte;
  194.         sr:SearchRec;
  195.         s,ss:PathStr;
  196.         BusyFile : FILE;
  197.         Ind, Ud : PBufTextFile;
  198.         l:STRING;
  199.         x:Word;
  200.       BEGIN
  201.         IF Schedule.Stat=' ' THEN Schedule.Stat:='H';
  202.         FOR i:=1 TO Num DO
  203.         BEGIN
  204.           s:=HoldFileName(Tab[i],False);
  205.           ss:=COPY(s,1,Length(s)-9);
  206.           s:=s+'?LO';
  207.           FindFirst(s,Archive,sr);
  208.           WHILE DOSError=0 DO
  209.           BEGIN
  210.             ch:=sr.name[10];
  211.             IF ch='F' THEN ch:='N';
  212.             IF (Length(sr.name)=12) AND (ch<>Schedule.Stat) THEN
  213.             BEGIN
  214.               IF Schedule.Stat='N' THEN ch2:='F' ELSE ch2:=Schedule.Stat;
  215.               IF MarkNodeBusy(BusyFile,Tab[i]) THEN
  216.               BEGIN
  217.                 New(Ud, InitCreate(ForceExtension(s,ch2+'LO'), SOpenWrite, 1024));
  218.                 IF Ud<>NIL THEN
  219.                 BEGIN
  220.                   New(Ind, Init(ss+sr.name, SOpenRead+ShareDenyRW, 1024));
  221.                   IF Ind<>NIL THEN
  222.                   BEGIN
  223.                     WHILE NOT Ind^.EoF AND (Ud^.GetStatus=0) DO
  224.                     BEGIN
  225.                       Ind^.ReadLn(l);
  226.                       Ud^.WriteLn(l);
  227.                     END;
  228.                     Dispose(Ind, Done);
  229.                     DeleteFile(ss+sr.name);
  230.                     AddLog('!','Changing stat of attaches for '+Address2Str(Tab[i]));
  231.                   END;
  232.                   Dispose(Ud, Done);
  233.                 END;
  234.                 UnMarkNodeBusy(BusyFile);
  235.               END;
  236.             END;
  237.             FindNext(sr);
  238.           END;
  239.           FindClose(sr);
  240.         END;
  241.  
  242.         FOR i:=1 TO Num DO
  243.         BEGIN
  244.           s:=HoldFileName(Tab[i],False);
  245.           ss:=COPY(s,1,Length(s)-9);
  246.           s:=s+'?UT';
  247.           FindFirst(s,Archive,sr);
  248.           WHILE DOSError=0 DO
  249.           BEGIN
  250.             ch:=sr.name[10];
  251.             IF ch='O' THEN ch:='N';
  252.             IF (Length(sr.name)=12) AND (ch<>Schedule.Stat) THEN
  253.             BEGIN
  254.               IF Schedule.Stat='N' THEN ch2:='O' ELSE ch2:=Schedule.Stat;
  255.               New(Ind, Init(ss+sr.name, SOpenRead+ShareDenyRW, 4096));
  256.               New(Ud, Init(COPY(s,1,Length(s)-3)+ch2+'UT', SOpenWrite+ShareDenyRW, 4096));
  257.               IF Ud<>Nil THEN
  258.               BEGIN
  259.                 Ud^.SetPos(1, PosEnd);
  260.                 Ind^.SetPos(SizeOf(TPktHeader), PosAbs);
  261.               END ELSE
  262.               BEGIN
  263.                 New(Ud, Init(COPY(s,1,Length(s)-3)+ch2+'UT', SCreate, 4096));
  264.               END;
  265.               WHILE NOT Ind^.EoF DO
  266.               BEGIN
  267.                 Ind^.Read(b, 1);
  268.                 Ud^.Write(b, 1);
  269.               END;
  270.               Dispose(Ind, Done);
  271.               Dispose(Ud, Done);
  272.               DeleteFile(ss+Sr.Name);
  273.               AddLog('!','Changing stat of mail packets '+Address2Str(Tab[i]));
  274.             END;
  275.             FindNext(sr);
  276.           END;
  277.           FindClose(sr);
  278.         END;
  279.       END;
  280.  
  281.       PROCEDURE KillScheduledPoll;
  282.       VAR
  283.         ch:Char;
  284.         i,j:Byte;
  285.         sr:SearchRec;
  286.         s:PathStr;
  287.       BEGIN
  288.         ExtFlags[3]:='F';
  289.         FOR j:=1 TO Num DO
  290.           FOR i:=1 TO 5 DO
  291.             IF (Schedule.Stat=' ') OR (Schedule.Stat=ExtFlags[i]) THEN
  292.             BEGIN
  293.               s:=HoldFileName(Tab[j],False)+ExtFlags[i]+'LO';
  294.               FindFirst(s,Archive,sr);
  295.               IF (DOSError=0) AND (sr.Size=0) THEN
  296.                 IF DeleteFile(s) THEN
  297.                   AddLog('!','Killed poll for '+Address2Str(Tab[Num]));
  298.               FindClose(sr);
  299.             END;
  300.       END;
  301.  
  302.     BEGIN
  303.       IF f.Open(StartPath+PoPScheduleFileName,SizeOf(TSchedule),False) THEN
  304.       BEGIN
  305.         WHILE NOT f.EOF DO
  306.         BEGIN
  307.           f.Read(Schedule,NoKeep,Wait);
  308.           IF (Schedule.Number=0) OR (Schedule.Number=CurrentEvent.SchedNumber) THEN
  309.           BEGIN
  310.             ReadSendTo(Schedule.Adr,Tab,Num);
  311.             CASE Schedule.Action OF
  312.               0 : ScheduledPoll;
  313.               1 : ScheduledChange;
  314.               4 : KillScheduledPoll;
  315.             END;
  316.           END;
  317.         END;
  318.         f.Close;
  319.       END;
  320.     END;
  321.  
  322.     FUNCTION FindCorrectEvent: Word;
  323.     VAR
  324.       ce,x,Min:LongInt;
  325.     BEGIN
  326.       EventFile.Seek(0);
  327.       ce:=0;
  328.       Min:=0;
  329.       WHILE NOT EventFile.EOF DO
  330.       BEGIN
  331.         EventFile.Read(TmpEvent,NoKeep,Wait);
  332.         IF (TmpEvent.TaskNumber=0) OR (TmpEvent.TaskNumber=Cfg.TaskNumber) THEN
  333.         BEGIN
  334.           IF (CurrentTime>=TmpEvent.Start) THEN
  335.           BEGIN
  336.             x:=(DaysTillRun(TmpEvent)*SecondsInDay)+TmpEvent.Start;
  337.             IF (x<86400) AND (x>=Min) THEN
  338.             BEGIN
  339.               Min:=x;
  340.               ce:=EventFile.FilePos;
  341.             END;
  342.           END;
  343.         END;
  344.       END;
  345.       IF ce=0 THEN ce:=Data.Event;
  346.       FindCorrectEvent:=ce;
  347.     END;
  348.  
  349.     FUNCTION NextEvent:Word;
  350.     VAR
  351.       x,Min:LongInt;
  352.       ne:Word;
  353.     BEGIN
  354.       EventFile.Seek(0);
  355.       ne:=0;
  356.       Min:=10*366*SecondsInDay;
  357.       WHILE NOT EventFile.EOF DO
  358.       BEGIN
  359.         EventFile.Read(TmpEvent,NoKeep,Wait);
  360.         IF (TmpEvent.TaskNumber=0) OR (TmpEvent.TaskNumber=Cfg.TaskNumber) THEN
  361.         BEGIN
  362.           x:=(DaysTillRun(TmpEvent)*SecondsInDay)+TmpEvent.Start;
  363.           IF (x<=Min) AND
  364.             ((TmpEvent.Start>Data.LastEventStart) OR (Data.LastEventStart=0)) THEN
  365.           BEGIN
  366.             Min:=x;
  367.             ne:=EventFile.FilePos;
  368.           END;
  369.         END;
  370.       END;
  371.       IF ne=0 THEN ne:=Data.Event;
  372.       NextEvent:=ne;
  373.     END;
  374.  
  375.   BEGIN
  376.     GetDate(datoaar,datomaaned,datodag,datodofw);
  377.     IF CurrentTime>=MaxTime-10 THEN Delay(1000);
  378.     NewEvent:=Data.Event;
  379.     IF (TimerExpired(NextEventTimer)) THEN
  380.     BEGIN
  381. {AddLog(' ', 'EVENT CHANGE: Time up');}
  382.       TestChange:=True;
  383.     END;
  384.     IF (Data.LastEventDate<>Today) THEN
  385.     BEGIN
  386. {AddLog(' ', 'EVENT CHANGE: New day '+DateToDateString('dd.mm.yy', Data.LastEventDate));}
  387.       TestChange:=True;
  388.       Data.LastEventDate:=Today-1;
  389.       Data.LastEventStart:=0;
  390.       Data.Event:=0;
  391.     END ELSE
  392.       IF (Abs(Data.LastEventStart-CurrentEvent.Start)>10) THEN
  393.       BEGIN
  394. {AddLog(' ', 'EVENT CHANGE: New event '+TimeToTimeString('hh:mm', Data.LastEventStart)+' '+
  395.             TimeToTimeString('hh:mm', CurrentEvent.Start));}
  396.         TestChange:=True;
  397.         Data.LastEventStart:=0;
  398.         IF (Data.Event<>0) THEN
  399.         BEGIN
  400.           ASM
  401.             OR CmdLineFlags, clJump2Event;
  402.           END;
  403.           Data.Event:=0;
  404.         END;
  405.       END;
  406.     IF (NOT TestChange) AND (Data.Event>0) AND ((CurrentEvent.Typ AND etDynamic)<>0) AND NOT MailToSend THEN
  407.     BEGIN
  408.       EventFile.Open(StartPath+PoPEventFileName, SizeOf(TEvent), True);
  409.       NewEvent:=NextEvent;
  410.       EventFile.Close;
  411.     END ELSE
  412.     BEGIN
  413.       IF TestChange THEN
  414.       BEGIN
  415.         EventFile.Open(StartPath+PoPEventFileName, SizeOf(TEvent), True);
  416.         CorrectEvent:=FindCorrectEvent;
  417.         IF Data.Event<>CorrectEvent THEN
  418.         BEGIN
  419.           IF CmdLineFlags AND clJump2Event=0 THEN NewEvent:=NextEvent
  420.                                              ELSE NewEvent:=CorrectEvent;
  421.         END ELSE
  422.           NewEvent:=Data.Event;
  423.         EventFile.Close;
  424.         CalculateEventTimes(False);
  425.       END;
  426.     END;
  427.  
  428.     IF Data.LastRan<>Today THEN
  429.     BEGIN
  430.       WITH StatRec^.DayStat[0] DO
  431.       BEGIN
  432.         AddLog(':', 'Totals today : '+Long2Str(callsout)+' calls out ('+Long2Str(callsgood)+ ' good), Cost '+Long2Str(Cost));
  433.         AddLog(':', 'Activity     : '+Long2Str(bbssessions)+' user calls, and '+Long2Str(mailsessions)+' mail sessions');
  434.         AddLog(':', 'Files count  : '+Long2Str(filesin)+' files in, and '+Long2Str(filesout)+' files out');
  435.       END;
  436.       Move(StatRec^ .DayStat[0],StatRec^.DayStat[1],14);
  437.       IF StatRec^.Start.D=0 THEN StatRec^.Start.D:=IncDate(Today,-1,0,0);
  438.       Inc(StatRec^.Total.CallsOut,StatRec^.DayStat[0].CallsOut);
  439.       Inc(StatRec^.Total.CallsGood,StatRec^.DayStat[0].CallsGood);
  440.       Inc(StatRec^.Total.Cost,StatRec^.DayStat[0].Cost);
  441.       Inc(StatRec^.Total.BBSSessions,StatRec^.DayStat[0].BBSSessions);
  442.       Inc(StatRec^.Total.MailSessions,StatRec^.DayStat[0].MailSessions);
  443.       Inc(StatRec^.Total.FilesIn,StatRec^.DayStat[0].FilesIn);
  444.       Inc(StatRec^.Total.FilesOut,StatRec^.DayStat[0].FilesOut);
  445.       FillChar(StatRec^.DayStat[0], 14, 0);
  446.       data.lastran:=Today;
  447.       IF (Cfg.TaskNumber<=1) AND (DeleteFile(StartPath+PoPDailyReqInfoFileName)) THEN
  448.         AddLog(':', 'Deleting Daily Request Info: PORTAL.DRI');
  449.     END;
  450.  
  451.     IF CmdLineFlags AND clJump2Event<>0 THEN
  452.       CmdLineFlags:=CmdLineFlags XOR clJump2Event;
  453.     IF Data.Event<>NewEvent THEN
  454.     BEGIN
  455.       EventFile.Open(StartPath+PoPEventFileName,SizeOf(TEvent),TRUE);
  456.       IF (Data.Event>0) AND ((CurrentEvent.Typ AND etOnceOnly)<>0) THEN
  457.       BEGIN
  458.         EventFile.GetRec(CurrentEvent,Data.Event-1,Keep,Wait);
  459.         CurrentEvent.Active:=CurrentEvent.Active AND 127;
  460.         EventFile.PutRec(CurrentEvent,Data.Event-1);
  461.       END;
  462.       EventFile.GetRec(CurrentEvent,NewEvent-1,NoKeep,Wait);
  463.       EventFile.Close;
  464.       Data.Event:=NewEvent;
  465.       Data.LastEventStart:=CurrentEvent.Start+1;
  466.       Data.LastEventDate:=Today;
  467.       UpdateStatusWindow;
  468.       AddLog(':', 'Starting event #'+Long2Str(NewEvent));
  469. {$IFNDEF NOMAILSCANNER}
  470.       IF CurrentEvent.Typ AND etScanMail<>0 THEN RunMailScanner(CurrentEvent.Typ);
  471. {$ENDIF}
  472.       IF ((CurrentEvent.Typ AND etClrOut)<>0) AND (Cfg.TaskNumber<2) THEN
  473.       BEGIN
  474.         IF DeleteFile(StartPath+PoPUndialFileName) THEN AddLog('#','Undialables cleared');
  475.       END;
  476.       CheckSchedules;
  477.       NewTimerSecs(Data.NextTime, CalculateNextTime);
  478.       IF (CurrentEvent.Typ AND etPoPList<>0) THEN ListMain;
  479.       IF CurrentEvent.InitExit <> 0 THEN
  480.       BEGIN
  481.         ComPort^.SetDtr(Low);
  482.         SpawnWithErrorlevel(CurrentEvent.InitExit, 'Exit at start of event', True);
  483.       END;
  484.       NewTimer(NextEventTimer, 0);
  485.       InitModemForEvent;
  486.       GetOutboundInformation;
  487.       UpdateOutboundWindow;
  488.     END ELSE
  489.       IF TestChange AND TimerExpired(NextEventTimer) THEN NewTimerSecs(NextEventTimer, 10);
  490.     IF Data.Event=0 THEN
  491.     BEGIN
  492.       AddLog('!','Portal events configured incorrectly. Please run PORTAL -c to correct');
  493.       FinishPortal;
  494.       Halt(250);
  495.     END;
  496.   END;
  497.  
  498. END.
  499.